23/05/2022
Dave Campbell
github.com/iamdavecampbell/tibble_house_on_the_prairie
Feel free to fork, star, download, correct typos,…
install.packages(c("tidyverse","tidytext","dplyr",
"stringr","janitor","lubridate",
"qdap","tools","text2vec",
"textdata"))
library(tidyverse) ## of course we're using tidyverse library(tidytext) ## some text tools, basic sentiment analysis library(dplyr) library(stringr) #handling strings library(janitor) ## make tables look nice library(lubridate) ## deal with dates library(qdap) ## handle polarization for sentiment analysis library(tools) ## to make one plot title look nice library(text2vec)## will use if we get to word embeddings library(textdata)## will use if we get to word embeddings
Note that I am using R>4.1 which gives me access to the |> operator. For reproducibility this is the R version that I am using.
version
## _ ## platform x86_64-apple-darwin17.0 ## arch x86_64 ## os darwin17.0 ## system x86_64, darwin17.0 ## status ## major 4 ## minor 1.1 ## year 2021 ## month 08 ## day 10 ## svn rev 80725 ## language R ## version.string R version 4.1.1 (2021-08-10) ## nickname Kick Things
Is there a difference in the sentiment in Bank of Canada speeches given to the House of Commons Standing Committee on Finance? Let’s compare 2018 vs 2022.
Use a lexicon of positive / negative words and count occurence within each article.
This is quick and easy, but it is hard to get a lexicon that is really tuned to your goals and era.
By default this ignores context ( costs fell “+”, profits fell “-”)
And modifiers ( my French comprehension is not bad “+”, my French spelling is not good “-”).
Modify a lexicon by editing some terms, looking for modifiers and/or merging terms that could be considered a single word “Data_Science”.
This requires some hands on effort and domain expertise. You’ll need to read some of the text.
This might involve searching for modifiers, such as not within a few words of bad.
This is equivalent to manually adding some structure to the model.
Note that pre-processing typically makes a lot of improvements but almost always introduces some undesirable effects.
Take a look at using Bank of Canada speeches.
The https://www.bankofcanada.ca/robots.txt file looks like we aren’t disallowed.
The other place to look for permission is in the webpage terms and conditions.
We can use Bank of Canada speeches as long as we provide them free of charge (or otherwise obtain the Bank’s permission) and attribute the Bank of Canada as the source. We must also exercise due diligence in ensuring the accuracy of any content.
Ask Me later about webscraping details if you like.
new_speeches = read_csv(file = "new_speeches.csv") old_speeches = read_csv(file = "old_speeches.csv")
There is no way of separating out data cleaning from data analysis.
tidytext::get_sentiments("afinn")
get_sentiments("afinn") |>
ggplot(aes(x = value))+
geom_histogram()
tidytext::get_sentiments("bing")
get_sentiments("bing") |>
ggplot(aes(x = sentiment, fill = sentiment))+
geom_bar()+
theme(axis.text.x = element_text(angle = 90,
vjust = 0.5, hjust=1))+
theme(legend.position = "none")
Lexicon of negative, positive, uncertainty, litigious, strong modal, weak modal, and constraining terms from the Loughran-McDonald financial dictionary see here
## The format is a list:
## Convert it as a data.frame / tibble
LMlex = rbind(
cbind(SentimentAnalysis::DictionaryLM$positive, "positive"),
cbind(SentimentAnalysis::DictionaryLM$negative, "negative"),
cbind(SentimentAnalysis::DictionaryLM$uncertainty, "uncertainty"))
colnames(LMlex) = c("term", "polarity")
LMlex = LMlex |>as_tibble()
LMlex |> ggplot(aes(x = polarity, fill = polarity))+ geom_bar()+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+ theme(legend.position = "none")
tidytext::get_sentiments("nrc")
get_sentiments("nrc") |>
ggplot(aes(x = sentiment, fill = sentiment))+
geom_bar()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
theme(legend.position = "none")
Note that each lexicon has a different length and words might evolve in meaning over time.
Back to sentiments, let’s count the nrc category occurences:
Speeches = rbind(new_speeches,old_speeches) |>
mutate(date = year(date) )|> ## simplify date to just the year
unnest_tokens(output = word,input = speech_text,
token = "words") |>
inner_join(get_sentiments("nrc") )
#Count the occurrence with each speech
Sents = Speeches |> group_by(date) |> count(sentiment)
Sents |> summarise(sum(n))
Sents |> filter(!(sentiment =="positive"|sentiment=="negative")) |>
ggplot(aes(fill=sentiment, y=n, x=as.factor(date))) +
geom_bar(position="fill", stat="identity")+
xlab("date")
Consider the Null Hypothesis that economic speeches have same sentiment distribution between 2018 and 2022.
The alternative is that there is an unspecified difference in distribution. This can be tested through a Chi-Square test for categorical distributions with \(N_r\) rows and \(N_c\) columns.
With observed counts \(O_{ij}\) in row \(i\) and column \(j\) of the table, the Expected counts are the data assuming the only difference is the total count; \[E_{ij}= (\mbox{row i total*column j total}) / N_{total}\]
This gives the test statistic: \[X = \sum_{i=1}^{N_r}\sum_{j=1}^{N_c}\frac{(O_{ij}-E_{ij})^2}{E_{ij}}\sim \chi^2_{(N_r-1)*(N_c-1)}\]
Remove the categories “positive” and “negative” since these are supersets of the other nrc categories.
The basic assumption is that these speeches are ‘bags of words’ that speeches are literally random samples of words rather than prose. Essentially the Bank of Canada has some sentiment distribution at a given time and the words used in speeches are a random sample thereof.
This is really just illustrative of how to analyze two time points, but related tools could track extend to regression or time series tools and consider all speeches.
#Cross-tab table
## this counts the occurences, so we don't use the 'summed' table above, but instead use the tibble that we joined on the sentiments:
MyTable = janitor::tabyl(
Speeches|>
filter(!(sentiment =="positive"|sentiment=="negative")) |>
group_by(date),
sentiment,date)
The janitor library makes it easy to build tables that look nice and can format data with row or column percents and counts. As a side note it also can put in row / column / total percentages,
MyTable |> adorn_totals("row") ## add a row for totals
## report column percentages rather than counts
MyTable |> adorn_percentages("col")
## report percentage of total and also counts
MyTable |> adorn_percentages("all")|> adorn_ns()
#Chi-Square test: chisq.test(MyTable)
when the counts within a table category are small, generally <5, the results may not be accurate.
Improving the lexicon by considering negation
Using a lexicon, consider the phrase: - “This workshop is not too bad.”
A lexicon based approach would see the word bad and consider the sentence to be negative, whereas not bad is actually pretty good all things considered.
Library qdap searches for the positive or negative word and then builds a window around it: [word-4,word+2].
Within that window it labels words as neutral words, negators, amplifiers, or de-amplifiers
It’s worthwhile to check out the word lists and make sure that they are suitable. Pre-processing choices impact analysis.
qdapDictionaries::amplification.words qdapDictionaries::deamplification.words qdapDictionaries::negation.words
A polarized word starts with a score of \(X_i=\pm 1\).
The amplifier / deamplifier weight is by default \(.8\).
The number of negator words, \(N_{Negator}\) flip the sign.
The polarity score for a word in the positive / negative list depends on the nearby words: \[P_{olarity}=\frac{(-1)^{N_{Negator}}(X_i + .8 * (A_{mplifiers} - D_{eamplifiers})) }{\sqrt{N_{WordsInSentence}}}\]
Amplifier words are counted but could be weighted:
\[A_{mplifiers} = N_{Amplifiers}I\!\!I(N_{deamplifiers}=0)\]
\[D_{eamplifiers} = max(-1,(-1^{N_{Negators}}N_{Amplifiers} +N_{Deamplifiers}))\]
Use a binary lexicon such as LMlex or bing
## inputs are a vector of positives, vector of negatives,...
positives = LMlex |> filter(polarity =="positive") |> pull(term)
negatives = LMlex |> filter(polarity =="negative") |> pull(term)
## this is a great place to add in more terms...
negatives = c(negatives, "invasion", "war", "uncertainty",
"upheaval","anxious", "risk", "tensions","tension")
positives = c(positives, "solid", "reassuring")
## put them into the sentiment lookup hash table
## note that we could set the positive and negative weights:
polarity_frame = sentiment_frame(positives, negatives)
## try a few sentences and extract the polarity:
polarity("This workshop is bad." ,
polarity.frame = polarity_frame)$all
polarity("This workshop is not great." ,
polarity.frame = polarity_frame)$all #negator 'seldom'
polarity("This workshop is not bad." ,
polarity.frame = polarity_frame)$all #negator 'seldom'
polarity("This workshop is ok" ,
polarity.frame = polarity_frame)$all ## neutral
polarity("This workshop is hardly very good" ,
polarity.frame = polarity_frame)$all #deamplifier 'hardly', amplifier 'very';(1+.8*(-(-1+1)))/sqrt(6)
polarity("This workshop is very seldom very good",
polarity.frame = polarity_frame)$all; #deamplifier 'seldom', amplifier 'very'x2;(1+.8*(0-(-2+1)))/sqrt(7)
polarity("This workshop is great" ,
polarity.frame = polarity_frame)$all
polarity("This workshop is really good" ,
polarity.frame = polarity_frame)$all #amplifier "really";(1+.8*(1))/sqrt(5)
polarity("This workshop is the absolute best" ,
polarity.frame = polarity_frame)$all #amplifier absolute?
#The data:
speeches_modified = rbind(new_speeches,old_speeches) |>
mutate(date = year(date) )|> ## simplify date to just the year
group_by(date)|> ## do these actions within the unique date values
unnest_tokens(output = paragraph,
input = speech_text,
token = "regex", pattern = "\n") |>## split into paragraphs
mutate(paragraph_count = row_number() )|> ## add a paragraph number
ungroup()
## check_text(speeches_modified[,"speech_text"])
Replacing numbers with words, handling some symbols like ‘%’ and “½”, and dealing with unexpected ending to sentences.
Alternatively check the spelling interactively as it skims through the text, but this is often too sensitive and flags jargon as typos:
## check_spelling_interactive(speeches_modified$speech_text)
speeches_modified = speeches_modified |>
mutate(paragraph = replace_number(paragraph))|> ## replace numbers
mutate(paragraph = str_replace_all(paragraph,
pattern = "(\t)|(\n)|(\r)",
replacement = ""))|> ##spaces, breaks
mutate(paragraph = str_replace_all(paragraph,
pattern = "\\%",
replacement = " percent"))|> ## symbols
mutate(paragraph = str_replace_all(paragraph,
pattern = "½",
replacement = " a half")) |>
mutate(paragraph = str_replace_all(paragraph,
pattern = "¼",
replacement = " a quarter"))|>
mutate(paragraph = add_incomplete(paragraph))
## handing potentially incomplete sentences
speeches_economy = speeches_modified |>
filter(str_detect(paragraph, "inflation"))
## split paragraphs into sentences
speeches_economy_sentence = speeches_economy |>
unnest_tokens(input = paragraph, output = sentences,
token = stringr::str_split,
pattern = "\\.|\\?|\\!") |> ## split at punctuation.
filter(sentences != "") ## remove empty sentences
## polarity_frame = sentiment_frame(positives, negatives)
speeches_economy_sentence = speeches_economy_sentence |>
mutate(polarity =
polarity(sentences, polarity.frame = polarity_frame)$all$polarity)
speeches_economy_sentence |>
filter(polarity!=0)|> ## remove the neutral filler stuff
ggplot(aes(x = polarity, colour = as.factor(date)))+
geom_density()+
ggtitle(tools::toTitleCase(
"Polarity of non-neutral sentences in paragraphs mentioning inflation"))
We could perform a statistical test for differences in the average polarity of polarized sentences relating to inflation.
\[H_o:\mu_{2018}\leq\mu_{2022}\]
\[H_a:\mu_{2018}>\mu_{2022}\]
We should consider whether or not to include the neutral sentences. It’s best to look at some of the neutral sentences.
speeches_economy_sentence |> filter(polarity==0) |> select(sentences) |> sample_n(10)## sample 10 random lines...
Given whatever we decide, we can run the t-test to check if the mean polarity in sentences from paragraphs discussing inflation in 2018 is greater than it is now in 2022.
t.test(polarity ~ date,
alternative = "greater",
var.equal = FALSE,
data = speeches_economy_sentence |>
mutate(date = as.factor(date))|>
filter(polarity!=0)#<-- consider this line carefully
)
With text it is often easy to get a whole lot of data.
- good data >> big data.
- With text data it’s hard to know what you have, but its definitely noisy, and has a lot of caveats.
In text analysis we are working to convert words into numbers, then we use standard tools. We could then get annotators to craft sentiment scores, then build a matrix, \(\mathbf{X}\) with one row per sentence, and columns as presence / absence of individual words.
This implies a very very wide \(\mathbf{X}\) matrix for fitting our sentiment scalar \(\hat{\mathbf{Y}} = f(\mathbf{X}\beta)\), so we need a lot of data.
In many cases we need to reduce the dimension of \(\mathbf{X}\) to somehow handle equivalent words.
Models like Word2Vec, GloVE, and BERT reduce the dimension of \(\mathbf{X}\) from 300,000 ish unique English words, to 300ish numeric dimensions. Often we use a pre-trained word embedding model made for another purpose and hope it’s good enough for us. Then we run our raw text through the word embedding as a dimension reduction tool and plug it into regression.
As statisticians know, it is usually best to reduce the dimension of \(\mathbf{X}\) while modelling \(\mathbf{Y}\) so that we end up with something optimal, but for computational reasons this is rarely done.
Reduced dimension models like BERT, GloVE, and Word2Vec are often called word embeddings. There is well known danger in blindly using them that has led to amplification of discrimination and human bias.
Continuous Bag of Words Fit a Neural Net with one hidden layer to predict a missing middle word from the context words.
- Input: 2xWindow size X 300,000 ish words
Hidden (embedding) dimension: 300ish
Output: 1 word from 300,000 words.
Skip-Gram Fit a Neural Net with one hidden layer to predict the context window words from the middle word
Input: 1 word from 300,000 ish words
Hidden (embedding) dimension: 300ish,
Output: 2xWindow size X 300,000ish words.
Create a matrix with word of interest X context words.
Entries are tallied co-occurences, weighted by distance of their occurence from word of interest.
Define low dimensional word embeddings optimizing a weighted least squares reconstruction of the log co-occurence counts.
library(textdata)
# 822.2 MB download
glove6b = embedding_glove6b(dimensions = 300,
manual_download=TRUE, return_path=TRUE)
# find nearby words in embedding space
Word_of_interest = glove6b["payment", , drop = FALSE]
text2vec::sim2(x = glove6b,
y = Word_of_interest,
method="cosine")
Biases we see in text are amplified in the embedding dimensions
We can find words close to each other and do vector addition and subtraction!
We might not like what we find.
Sentiments
Given an imprecise Bank speech quote, which year is it from?
Split the speech sentences into test-train, use Year as \(\mathbf{Y}\).
Push sentences through embedding model and average over sentences, these become \(\mathbf{X}\).
Fit a (fancy?) regression model predicting \(\hat{\mathbf{Y}}\) from \(\mathbf{X}\).
Run the imprecise quote through the model to estimate the year it was spoken.
Mikolov, T., Chen, K., Corrado, G., & Dean, J. (2013). Efficient estimation of word representations in vector space. 1st International Conference on Learning Representations, ICLR 2013 - Workshop Track Proceedings, 1–12.
Mikolov, T., Sutskever, I., Chen, K., Corrado, G. S., & Dean, J. (2013). Distributed Representations of Words and Phrases and their Compositionality. Advances in Neural Information Processing Systems, 26. https://doi.org/10.18653/v1/d16-1146